home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / perl5 / HTTP / Cookies.pm < prev    next >
Text File  |  2009-06-15  |  20KB  |  760 lines
  1. package HTTP::Cookies;
  2.  
  3. use strict;
  4. use HTTP::Date qw(str2time time2str);
  5. use HTTP::Headers::Util qw(_split_header_words join_header_words);
  6.  
  7. use vars qw($VERSION $EPOCH_OFFSET);
  8. $VERSION = "5.827";
  9.  
  10. # Legacy: because "use "HTTP::Cookies" used be the ONLY way
  11. #  to load the class HTTP::Cookies::Netscape.
  12. require HTTP::Cookies::Netscape;
  13.  
  14. $EPOCH_OFFSET = 0;  # difference from Unix epoch
  15. if ($^O eq "MacOS") {
  16.     require Time::Local;
  17.     $EPOCH_OFFSET = Time::Local::timelocal(0,0,0,1,0,70);
  18. }
  19.  
  20. # A HTTP::Cookies object is a hash.  The main attribute is the
  21. # COOKIES 3 level hash:  $self->{COOKIES}{$domain}{$path}{$key}.
  22.  
  23. sub new
  24. {
  25.     my $class = shift;
  26.     my $self = bless {
  27.     COOKIES => {},
  28.     }, $class;
  29.     my %cnf = @_;
  30.     for (keys %cnf) {
  31.     $self->{lc($_)} = $cnf{$_};
  32.     }
  33.     $self->load;
  34.     $self;
  35. }
  36.  
  37.  
  38. sub add_cookie_header
  39. {
  40.     my $self = shift;
  41.     my $request = shift || return;
  42.     my $url = $request->uri;
  43.     my $scheme = $url->scheme;
  44.     unless ($scheme =~ /^https?\z/) {
  45.     return;
  46.     }
  47.  
  48.     my $domain = _host($request, $url);
  49.     $domain = "$domain.local" unless $domain =~ /\./;
  50.     my $secure_request = ($scheme eq "https");
  51.     my $req_path = _url_path($url);
  52.     my $req_port = $url->port;
  53.     my $now = time();
  54.     _normalize_path($req_path) if $req_path =~ /%/;
  55.  
  56.     my @cval;    # cookie values for the "Cookie" header
  57.     my $set_ver;
  58.     my $netscape_only = 0; # An exact domain match applies to any cookie
  59.  
  60.     while ($domain =~ /\./) {
  61.         # Checking $domain for cookies"
  62.     my $cookies = $self->{COOKIES}{$domain};
  63.     next unless $cookies;
  64.     if ($self->{delayload} && defined($cookies->{'//+delayload'})) {
  65.         my $cookie_data = $cookies->{'//+delayload'}{'cookie'};
  66.         delete $self->{COOKIES}{$domain};
  67.         $self->load_cookie($cookie_data->[1]);
  68.         $cookies = $self->{COOKIES}{$domain};
  69.         next unless $cookies;  # should not really happen
  70.     }
  71.  
  72.     # Want to add cookies corresponding to the most specific paths
  73.     # first (i.e. longest path first)
  74.     my $path;
  75.     for $path (sort {length($b) <=> length($a) } keys %$cookies) {
  76.         if (index($req_path, $path) != 0) {
  77.         next;
  78.         }
  79.  
  80.         my($key,$array);
  81.         while (($key,$array) = each %{$cookies->{$path}}) {
  82.         my($version,$val,$port,$path_spec,$secure,$expires) = @$array;
  83.         if ($secure && !$secure_request) {
  84.             next;
  85.         }
  86.         if ($expires && $expires < $now) {
  87.             next;
  88.         }
  89.         if ($port) {
  90.             my $found;
  91.             if ($port =~ s/^_//) {
  92.             # The correponding Set-Cookie attribute was empty
  93.             $found++ if $port eq $req_port;
  94.             $port = "";
  95.             }
  96.             else {
  97.             my $p;
  98.             for $p (split(/,/, $port)) {
  99.                 $found++, last if $p eq $req_port;
  100.             }
  101.             }
  102.             unless ($found) {
  103.             next;
  104.             }
  105.         }
  106.         if ($version > 0 && $netscape_only) {
  107.             next;
  108.         }
  109.  
  110.         # set version number of cookie header.
  111.             # XXX: What should it be if multiple matching
  112.                 #      Set-Cookie headers have different versions themselves
  113.         if (!$set_ver++) {
  114.             if ($version >= 1) {
  115.             push(@cval, "\$Version=$version");
  116.             }
  117.             elsif (!$self->{hide_cookie2}) {
  118.             $request->header(Cookie2 => '$Version="1"');
  119.             }
  120.         }
  121.  
  122.         # do we need to quote the value
  123.         if ($val =~ /\W/ && $version) {
  124.             $val =~ s/([\\\"])/\\$1/g;
  125.             $val = qq("$val");
  126.         }
  127.  
  128.         # and finally remember this cookie
  129.         push(@cval, "$key=$val");
  130.         if ($version >= 1) {
  131.             push(@cval, qq(\$Path="$path"))     if $path_spec;
  132.             push(@cval, qq(\$Domain="$domain")) if $domain =~ /^\./;
  133.             if (defined $port) {
  134.             my $p = '$Port';
  135.             $p .= qq(="$port") if length $port;
  136.             push(@cval, $p);
  137.             }
  138.         }
  139.  
  140.         }
  141.         }
  142.  
  143.     } continue {
  144.     # Try with a more general domain, alternately stripping
  145.     # leading name components and leading dots.  When this
  146.     # results in a domain with no leading dot, it is for
  147.     # Netscape cookie compatibility only:
  148.     #
  149.     # a.b.c.net    Any cookie
  150.     # .b.c.net    Any cookie
  151.     # b.c.net    Netscape cookie only
  152.     # .c.net    Any cookie
  153.  
  154.     if ($domain =~ s/^\.+//) {
  155.         $netscape_only = 1;
  156.     }
  157.     else {
  158.         $domain =~ s/[^.]*//;
  159.         $netscape_only = 0;
  160.     }
  161.     }
  162.  
  163.     $request->header(Cookie => join("; ", @cval)) if @cval;
  164.  
  165.     $request;
  166. }
  167.  
  168.  
  169. sub extract_cookies
  170. {
  171.     my $self = shift;
  172.     my $response = shift || return;
  173.  
  174.     my @set = _split_header_words($response->_header("Set-Cookie2"));
  175.     my @ns_set = $response->_header("Set-Cookie");
  176.  
  177.     return $response unless @set || @ns_set;  # quick exit
  178.  
  179.     my $request = $response->request;
  180.     my $url = $request->uri;
  181.     my $req_host = _host($request, $url);
  182.     $req_host = "$req_host.local" unless $req_host =~ /\./;
  183.     my $req_port = $url->port;
  184.     my $req_path = _url_path($url);
  185.     _normalize_path($req_path) if $req_path =~ /%/;
  186.  
  187.     if (@ns_set) {
  188.     # The old Netscape cookie format for Set-Cookie
  189.     # http://wp.netscape.com/newsref/std/cookie_spec.html
  190.     # can for instance contain an unquoted "," in the expires
  191.     # field, so we have to use this ad-hoc parser.
  192.     my $now = time();
  193.  
  194.     # Build a hash of cookies that was present in Set-Cookie2
  195.     # headers.  We need to skip them if we also find them in a
  196.     # Set-Cookie header.
  197.     my %in_set2;
  198.     for (@set) {
  199.         $in_set2{$_->[0]}++;
  200.     }
  201.  
  202.     my $set;
  203.     for $set (@ns_set) {
  204.             $set =~ s/^\s+//;
  205.         my @cur;
  206.         my $param;
  207.         my $expires;
  208.         my $first_param = 1;
  209.         for $param (split(/;\s*/, $set)) {
  210.                 next unless length($param);
  211.         my($k,$v) = split(/\s*=\s*/, $param, 2);
  212.         if (defined $v) {
  213.             $v =~ s/\s+$//;
  214.             #print "$k => $v\n";
  215.         }
  216.         else {
  217.             $k =~ s/\s+$//;
  218.             #print "$k => undef";
  219.         }
  220.         if (!$first_param && lc($k) eq "expires") {
  221.             my $etime = str2time($v);
  222.             if ($etime) {
  223.             push(@cur, "Max-Age" => str2time($v) - $now);
  224.             $expires++;
  225.             }
  226.         }
  227.                 elsif (!$first_param && lc($k) =~ /^(?:version|discard|ns-cookie)/) {
  228.                     # ignore
  229.                 }
  230.         else {
  231.             push(@cur, $k => $v);
  232.         }
  233.         $first_param = 0;
  234.         }
  235.             next unless @cur;
  236.         next if $in_set2{$cur[0]};
  237.  
  238. #        push(@cur, "Port" => $req_port);
  239.         push(@cur, "Discard" => undef) unless $expires;
  240.         push(@cur, "Version" => 0);
  241.         push(@cur, "ns-cookie" => 1);
  242.         push(@set, \@cur);
  243.     }
  244.     }
  245.  
  246.   SET_COOKIE:
  247.     for my $set (@set) {
  248.     next unless @$set >= 2;
  249.  
  250.     my $key = shift @$set;
  251.     my $val = shift @$set;
  252.  
  253.     my %hash;
  254.     while (@$set) {
  255.         my $k = shift @$set;
  256.         my $v = shift @$set;
  257.         my $lc = lc($k);
  258.         # don't loose case distinction for unknown fields
  259.         $k = $lc if $lc =~ /^(?:discard|domain|max-age|
  260.                                     path|port|secure|version)$/x;
  261.         if ($k eq "discard" || $k eq "secure") {
  262.         $v = 1 unless defined $v;
  263.         }
  264.         next if exists $hash{$k};  # only first value is signigicant
  265.         $hash{$k} = $v;
  266.     };
  267.  
  268.     my %orig_hash = %hash;
  269.     my $version   = delete $hash{version};
  270.     $version = 1 unless defined($version);
  271.     my $discard   = delete $hash{discard};
  272.     my $secure    = delete $hash{secure};
  273.     my $maxage    = delete $hash{'max-age'};
  274.     my $ns_cookie = delete $hash{'ns-cookie'};
  275.  
  276.     # Check domain
  277.     my $domain  = delete $hash{domain};
  278.     $domain = lc($domain) if defined $domain;
  279.     if (defined($domain)
  280.         && $domain ne $req_host && $domain ne ".$req_host") {
  281.         if ($domain !~ /\./ && $domain ne "local") {
  282.         next SET_COOKIE;
  283.         }
  284.         $domain = ".$domain" unless $domain =~ /^\./;
  285.         if ($domain =~ /\.\d+$/) {
  286.         next SET_COOKIE;
  287.         }
  288.         my $len = length($domain);
  289.         unless (substr($req_host, -$len) eq $domain) {
  290.         next SET_COOKIE;
  291.         }
  292.         my $hostpre = substr($req_host, 0, length($req_host) - $len);
  293.         if ($hostpre =~ /\./ && !$ns_cookie) {
  294.         next SET_COOKIE;
  295.         }
  296.     }
  297.     else {
  298.         $domain = $req_host;
  299.     }
  300.  
  301.     my $path = delete $hash{path};
  302.     my $path_spec;
  303.     if (defined $path && $path ne '') {
  304.         $path_spec++;
  305.         _normalize_path($path) if $path =~ /%/;
  306.         if (!$ns_cookie &&
  307.                 substr($req_path, 0, length($path)) ne $path) {
  308.         next SET_COOKIE;
  309.         }
  310.     }
  311.     else {
  312.         $path = $req_path;
  313.         $path =~ s,/[^/]*$,,;
  314.         $path = "/" unless length($path);
  315.     }
  316.  
  317.     my $port;
  318.     if (exists $hash{port}) {
  319.         $port = delete $hash{port};
  320.         if (defined $port) {
  321.         $port =~ s/\s+//g;
  322.         my $found;
  323.         for my $p (split(/,/, $port)) {
  324.             unless ($p =~ /^\d+$/) {
  325.             next SET_COOKIE;
  326.             }
  327.             $found++ if $p eq $req_port;
  328.         }
  329.         unless ($found) {
  330.             next SET_COOKIE;
  331.         }
  332.         }
  333.         else {
  334.         $port = "_$req_port";
  335.         }
  336.     }
  337.     $self->set_cookie($version,$key,$val,$path,$domain,$port,$path_spec,$secure,$maxage,$discard, \%hash)
  338.         if $self->set_cookie_ok(\%orig_hash);
  339.     }
  340.  
  341.     $response;
  342. }
  343.  
  344. sub set_cookie_ok
  345. {
  346.     1;
  347. }
  348.  
  349.  
  350. sub set_cookie
  351. {
  352.     my $self = shift;
  353.     my($version,
  354.        $key, $val, $path, $domain, $port,
  355.        $path_spec, $secure, $maxage, $discard, $rest) = @_;
  356.  
  357.     # path and key can not be empty (key can't start with '$')
  358.     return $self if !defined($path) || $path !~ m,^/, ||
  359.                 !defined($key)  || $key  =~ m,^\$,;
  360.  
  361.     # ensure legal port
  362.     if (defined $port) {
  363.     return $self unless $port =~ /^_?\d+(?:,\d+)*$/;
  364.     }
  365.  
  366.     my $expires;
  367.     if (defined $maxage) {
  368.     if ($maxage <= 0) {
  369.         delete $self->{COOKIES}{$domain}{$path}{$key};
  370.         return $self;
  371.     }
  372.     $expires = time() + $maxage;
  373.     }
  374.     $version = 0 unless defined $version;
  375.  
  376.     my @array = ($version, $val,$port,
  377.          $path_spec,
  378.          $secure, $expires, $discard);
  379.     push(@array, {%$rest}) if defined($rest) && %$rest;
  380.     # trim off undefined values at end
  381.     pop(@array) while !defined $array[-1];
  382.  
  383.     $self->{COOKIES}{$domain}{$path}{$key} = \@array;
  384.     $self;
  385. }
  386.  
  387.  
  388. sub save
  389. {
  390.     my $self = shift;
  391.     my $file = shift || $self->{'file'} || return;
  392.     local(*FILE);
  393.     open(FILE, ">$file") or die "Can't open $file: $!";
  394.     print FILE "#LWP-Cookies-1.0\n";
  395.     print FILE $self->as_string(!$self->{ignore_discard});
  396.     close(FILE);
  397.     1;
  398. }
  399.  
  400.  
  401. sub load
  402. {
  403.     my $self = shift;
  404.     my $file = shift || $self->{'file'} || return;
  405.     local(*FILE, $_);
  406.     local $/ = "\n";  # make sure we got standard record separator
  407.     open(FILE, $file) or return;
  408.     my $magic = <FILE>;
  409.     unless ($magic =~ /^\#LWP-Cookies-(\d+\.\d+)/) {
  410.     warn "$file does not seem to contain cookies";
  411.     return;
  412.     }
  413.     while (<FILE>) {
  414.     next unless s/^Set-Cookie3:\s*//;
  415.     chomp;
  416.     my $cookie;
  417.     for $cookie (_split_header_words($_)) {
  418.         my($key,$val) = splice(@$cookie, 0, 2);
  419.         my %hash;
  420.         while (@$cookie) {
  421.         my $k = shift @$cookie;
  422.         my $v = shift @$cookie;
  423.         $hash{$k} = $v;
  424.         }
  425.         my $version   = delete $hash{version};
  426.         my $path      = delete $hash{path};
  427.         my $domain    = delete $hash{domain};
  428.         my $port      = delete $hash{port};
  429.         my $expires   = str2time(delete $hash{expires});
  430.  
  431.         my $path_spec = exists $hash{path_spec}; delete $hash{path_spec};
  432.         my $secure    = exists $hash{secure};    delete $hash{secure};
  433.         my $discard   = exists $hash{discard};   delete $hash{discard};
  434.  
  435.         my @array =    ($version,$val,$port,
  436.              $path_spec,$secure,$expires,$discard);
  437.         push(@array, \%hash) if %hash;
  438.         $self->{COOKIES}{$domain}{$path}{$key} = \@array;
  439.     }
  440.     }
  441.     close(FILE);
  442.     1;
  443. }
  444.  
  445.  
  446. sub revert
  447. {
  448.     my $self = shift;
  449.     $self->clear->load;
  450.     $self;
  451. }
  452.  
  453.  
  454. sub clear
  455. {
  456.     my $self = shift;
  457.     if (@_ == 0) {
  458.     $self->{COOKIES} = {};
  459.     }
  460.     elsif (@_ == 1) {
  461.     delete $self->{COOKIES}{$_[0]};
  462.     }
  463.     elsif (@_ == 2) {
  464.     delete $self->{COOKIES}{$_[0]}{$_[1]};
  465.     }
  466.     elsif (@_ == 3) {
  467.     delete $self->{COOKIES}{$_[0]}{$_[1]}{$_[2]};
  468.     }
  469.     else {
  470.     require Carp;
  471.         Carp::carp('Usage: $c->clear([domain [,path [,key]]])');
  472.     }
  473.     $self;
  474. }
  475.  
  476.  
  477. sub clear_temporary_cookies
  478. {
  479.     my($self) = @_;
  480.  
  481.     $self->scan(sub {
  482.         if($_[9] or        # "Discard" flag set
  483.            not $_[8]) {    # No expire field?
  484.             $_[8] = -1;            # Set the expire/max_age field
  485.             $self->set_cookie(@_); # Clear the cookie
  486.         }
  487.       });
  488. }
  489.  
  490.  
  491. sub DESTROY
  492. {
  493.     my $self = shift;
  494.     local($., $@, $!, $^E, $?);
  495.     $self->save if $self->{'autosave'};
  496. }
  497.  
  498.  
  499. sub scan
  500. {
  501.     my($self, $cb) = @_;
  502.     my($domain,$path,$key);
  503.     for $domain (sort keys %{$self->{COOKIES}}) {
  504.     for $path (sort keys %{$self->{COOKIES}{$domain}}) {
  505.         for $key (sort keys %{$self->{COOKIES}{$domain}{$path}}) {
  506.         my($version,$val,$port,$path_spec,
  507.            $secure,$expires,$discard,$rest) =
  508.                @{$self->{COOKIES}{$domain}{$path}{$key}};
  509.         $rest = {} unless defined($rest);
  510.         &$cb($version,$key,$val,$path,$domain,$port,
  511.              $path_spec,$secure,$expires,$discard,$rest);
  512.         }
  513.     }
  514.     }
  515. }
  516.  
  517.  
  518. sub as_string
  519. {
  520.     my($self, $skip_discard) = @_;
  521.     my @res;
  522.     $self->scan(sub {
  523.     my($version,$key,$val,$path,$domain,$port,
  524.        $path_spec,$secure,$expires,$discard,$rest) = @_;
  525.     return if $discard && $skip_discard;
  526.     my @h = ($key, $val);
  527.     push(@h, "path", $path);
  528.     push(@h, "domain" => $domain);
  529.     push(@h, "port" => $port) if defined $port;
  530.     push(@h, "path_spec" => undef) if $path_spec;
  531.     push(@h, "secure" => undef) if $secure;
  532.     push(@h, "expires" => HTTP::Date::time2isoz($expires)) if $expires;
  533.     push(@h, "discard" => undef) if $discard;
  534.     my $k;
  535.     for $k (sort keys %$rest) {
  536.         push(@h, $k, $rest->{$k});
  537.     }
  538.     push(@h, "version" => $version);
  539.     push(@res, "Set-Cookie3: " . join_header_words(\@h));
  540.     });
  541.     join("\n", @res, "");
  542. }
  543.  
  544. sub _host
  545. {
  546.     my($request, $url) = @_;
  547.     if (my $h = $request->header("Host")) {
  548.     $h =~ s/:\d+$//;  # might have a port as well
  549.     return lc($h);
  550.     }
  551.     return lc($url->host);
  552. }
  553.  
  554. sub _url_path
  555. {
  556.     my $url = shift;
  557.     my $path;
  558.     if($url->can('epath')) {
  559.        $path = $url->epath;    # URI::URL method
  560.     }
  561.     else {
  562.        $path = $url->path;           # URI::_generic method
  563.     }
  564.     $path = "/" unless length $path;
  565.     $path;
  566. }
  567.  
  568. sub _normalize_path  # so that plain string compare can be used
  569. {
  570.     my $x;
  571.     $_[0] =~ s/%([0-9a-fA-F][0-9a-fA-F])/
  572.              $x = uc($1);
  573.                  $x eq "2F" || $x eq "25" ? "%$x" :
  574.                                             pack("C", hex($x));
  575.               /eg;
  576.     $_[0] =~ s/([\0-\x20\x7f-\xff])/sprintf("%%%02X",ord($1))/eg;
  577. }
  578.  
  579. 1;
  580.  
  581. __END__
  582.  
  583. =head1 NAME
  584.  
  585. HTTP::Cookies - HTTP cookie jars
  586.  
  587. =head1 SYNOPSIS
  588.  
  589.   use HTTP::Cookies;
  590.   $cookie_jar = HTTP::Cookies->new(
  591.     file => "$ENV{'HOME'}/lwp_cookies.dat',
  592.     autosave => 1,
  593.   );
  594.  
  595.   use LWP;
  596.   my $browser = LWP::UserAgent->new;
  597.   $browser->cookie_jar($cookie_jar);
  598.  
  599. Or for an empty and temporary cookie jar:
  600.  
  601.   use LWP;
  602.   my $browser = LWP::UserAgent->new;
  603.   $browser->cookie_jar( {} );
  604.  
  605. =head1 DESCRIPTION
  606.  
  607. This class is for objects that represent a "cookie jar" -- that is, a
  608. database of all the HTTP cookies that a given LWP::UserAgent object
  609. knows about.
  610.  
  611. Cookies are a general mechanism which server side connections can use
  612. to both store and retrieve information on the client side of the
  613. connection.  For more information about cookies refer to
  614. <URL:http://wp.netscape.com/newsref/std/cookie_spec.html> and
  615. <URL:http://www.cookiecentral.com/>.  This module also implements the
  616. new style cookies described in I<RFC 2965>.
  617. The two variants of cookies are supposed to be able to coexist happily.
  618.  
  619. Instances of the class I<HTTP::Cookies> are able to store a collection
  620. of Set-Cookie2: and Set-Cookie: headers and are able to use this
  621. information to initialize Cookie-headers in I<HTTP::Request> objects.
  622. The state of a I<HTTP::Cookies> object can be saved in and restored from
  623. files.
  624.  
  625. =head1 METHODS
  626.  
  627. The following methods are provided:
  628.  
  629. =over 4
  630.  
  631. =item $cookie_jar = HTTP::Cookies->new
  632.  
  633. The constructor takes hash style parameters.  The following
  634. parameters are recognized:
  635.  
  636.   file:            name of the file to restore cookies from and save cookies to
  637.   autosave:        save during destruction (bool)
  638.   ignore_discard:  save even cookies that are requested to be discarded (bool)
  639.   hide_cookie2:    do not add Cookie2 header to requests
  640.  
  641. Future parameters might include (not yet implemented):
  642.  
  643.   max_cookies               300
  644.   max_cookies_per_domain    20
  645.   max_cookie_size           4096
  646.  
  647.   no_cookies   list of domain names that we never return cookies to
  648.  
  649. =item $cookie_jar->add_cookie_header( $request )
  650.  
  651. The add_cookie_header() method will set the appropriate Cookie:-header
  652. for the I<HTTP::Request> object given as argument.  The $request must
  653. have a valid url attribute before this method is called.
  654.  
  655. =item $cookie_jar->extract_cookies( $response )
  656.  
  657. The extract_cookies() method will look for Set-Cookie: and
  658. Set-Cookie2: headers in the I<HTTP::Response> object passed as
  659. argument.  Any of these headers that are found are used to update
  660. the state of the $cookie_jar.
  661.  
  662. =item $cookie_jar->set_cookie( $version, $key, $val, $path, $domain, $port, $path_spec, $secure, $maxage, $discard, \%rest )
  663.  
  664. The set_cookie() method updates the state of the $cookie_jar.  The
  665. $key, $val, $domain, $port and $path arguments are strings.  The
  666. $path_spec, $secure, $discard arguments are boolean values. The $maxage
  667. value is a number indicating number of seconds that this cookie will
  668. live.  A value <= 0 will delete this cookie.  %rest defines
  669. various other attributes like "Comment" and "CommentURL".
  670.  
  671. =item $cookie_jar->save
  672.  
  673. =item $cookie_jar->save( $file )
  674.  
  675. This method file saves the state of the $cookie_jar to a file.
  676. The state can then be restored later using the load() method.  If a
  677. filename is not specified we will use the name specified during
  678. construction.  If the attribute I<ignore_discard> is set, then we
  679. will even save cookies that are marked to be discarded.
  680.  
  681. The default is to save a sequence of "Set-Cookie3" lines.
  682. "Set-Cookie3" is a proprietary LWP format, not known to be compatible
  683. with any browser.  The I<HTTP::Cookies::Netscape> sub-class can
  684. be used to save in a format compatible with Netscape.
  685.  
  686. =item $cookie_jar->load
  687.  
  688. =item $cookie_jar->load( $file )
  689.  
  690. This method reads the cookies from the file and adds them to the
  691. $cookie_jar.  The file must be in the format written by the save()
  692. method.
  693.  
  694. =item $cookie_jar->revert
  695.  
  696. This method empties the $cookie_jar and re-loads the $cookie_jar
  697. from the last save file.
  698.  
  699. =item $cookie_jar->clear
  700.  
  701. =item $cookie_jar->clear( $domain )
  702.  
  703. =item $cookie_jar->clear( $domain, $path )
  704.  
  705. =item $cookie_jar->clear( $domain, $path, $key )
  706.  
  707. Invoking this method without arguments will empty the whole
  708. $cookie_jar.  If given a single argument only cookies belonging to
  709. that domain will be removed.  If given two arguments, cookies
  710. belonging to the specified path within that domain are removed.  If
  711. given three arguments, then the cookie with the specified key, path
  712. and domain is removed.
  713.  
  714. =item $cookie_jar->clear_temporary_cookies
  715.  
  716. Discard all temporary cookies. Scans for all cookies in the jar
  717. with either no expire field or a true C<discard> flag. To be
  718. called when the user agent shuts down according to RFC 2965.
  719.  
  720. =item $cookie_jar->scan( \&callback )
  721.  
  722. The argument is a subroutine that will be invoked for each cookie
  723. stored in the $cookie_jar.  The subroutine will be invoked with
  724. the following arguments:
  725.  
  726.   0  version
  727.   1  key
  728.   2  val
  729.   3  path
  730.   4  domain
  731.   5  port
  732.   6  path_spec
  733.   7  secure
  734.   8  expires
  735.   9  discard
  736.  10  hash
  737.  
  738. =item $cookie_jar->as_string
  739.  
  740. =item $cookie_jar->as_string( $skip_discardables )
  741.  
  742. The as_string() method will return the state of the $cookie_jar
  743. represented as a sequence of "Set-Cookie3" header lines separated by
  744. "\n".  If $skip_discardables is TRUE, it will not return lines for
  745. cookies with the I<Discard> attribute.
  746.  
  747. =back
  748.  
  749. =head1 SEE ALSO
  750.  
  751. L<HTTP::Cookies::Netscape>, L<HTTP::Cookies::Microsoft>
  752.  
  753. =head1 COPYRIGHT
  754.  
  755. Copyright 1997-2002 Gisle Aas
  756.  
  757. This library is free software; you can redistribute it and/or
  758. modify it under the same terms as Perl itself.
  759.  
  760.